# function to require packages
foo <- function(x){
  for( i in x ){
    #  require returns TRUE invisibly if it was able to load package
    if( ! require( i , character.only = TRUE ) ){
      #  If package was not able to be loaded then re-install
      install.packages( i , dependencies = TRUE )
      #  Load package after installing
      require( i , character.only = TRUE )
    }
  }
}
#Function to compute the difference vector by vector of two matrices
distr <- function(v1,v2) { #v1 and v2 must be matrices
  Lleng <- ncol(v1)
  v1 <- as.matrix(v1)
  v2 <- as.matrix(v2)
  resultdist <- c(1:Lleng)
  for (pos in c(1:Lleng)) {
    resultdist[pos] <- dist(rbind(v1[,pos],v2[,pos]))
  }
  return(resultdist)
}
# function to go from wide to long, by specify "choicevar", and alternative specific vars c(" ")
tolong <- function(datas,choicevar,altvar) { 
  mldata <- match.call(expand.dots = FALSE) #complete call i.e. tolong(formula = choice ~ 0 | x + xwk | swk, data = datalong.wk, method = "nr", print.level = 0)
  m <- match(c("choicevar","altvar"), names(mldata), 0L)
  choicename<- mldata[[m[1]]]
  #L <- max(datas[[choicename]])
  if (length(mldata[[m[2]]])>1)  prevarname <- sapply(c(2:length(mldata[[m[2]]])),function(x) mldata[[m[2]]][[x]]) else prevarname <- paste(mldata[[m[2]]])
  mL <- min(as.numeric(gsub(paste("^",prevarname[1],sep=""),replacement="", grep(paste("^",prevarname[1],sep=""), names(datas),value=TRUE))) )
  ML <- max(as.numeric(gsub(paste("^",prevarname[1],sep=""),replacement="", grep(paste("^",prevarname[1],sep=""), names(datas),value=TRUE))) )
  #datas <- mldata[[2]]
  #check if there is all the choices present, otherwise do trick and then replace back true choices
  check <- setdiff(c(mL:ML),unique(datas[[choicename]]))
  lcheck <- length(check)
  if ( lcheck > 0) {
    ##truechoice <- datas[c(1:lcheck),][[choicename]]
    truechoice <- datas[c(1:length(c(mL:ML))),][[choicename]]
    ##datas[c(1:lcheck),][[choicename]] <- c(check)
    datas[c(1:length(c(mL:ML))),][[choicename]] <- c(mL:ML)
  } 
  mdata <- mlogit.data(datas,choice=choicename, shape="wide",varying=match(c(sapply(prevarname, function(x) c(paste(x,c(mL:ML),sep="")), USE.NAMES=FALSE)),colnames(datas)))
  if (lcheck > 0) {
    ##for(llcheck in c(1:lcheck)) {
    for(llcheck in c(1:length(c(mL:ML)))) {
      lalt <- length(c(mL:ML))
      mdata[(lalt*(llcheck-1)+1):(llcheck*lalt),][[choicename]] <- (c(mL:ML) == truechoice[llcheck])
    }
  }
  mdata
}
# function to get at least one neighbour but warranting that the street level neighbours hold 
atleast1nei <- function(x) {
  kneighbours1<- knn2nb(knearneigh(x,1))
  all.linked <- max(unlist(nbdists(kneighbours1, x)))
  diststreetnei <- round(dist(matrix(c(max(rnorm(10000,0,0.1)),max(rnorm(10000,0,0.1)),min(rnorm(10000,0,0.1)),min(rnorm(10000,0,0.1))),ncol=2,byrow=TRUE)),1) #defining max distance to be considered as a neighbour, so that, after jittering we still identify those living in the same street as neighbours
  distnei <- max(all.linked,diststreetnei)
  dnearneigh(x,0,distnei)
}
# function to get at leastmost kn neighbour but warranting that the street level neighbours hold 
atmost10nei <- function(x) {
  knn2nb(knearneigh(x,10))
}
#function based on distance 50 mts
within50nei <- function(x) {
  kneighbours1<- knn2nb(knearneigh(x,1))
  all.linked <- max(unlist(nbdists(kneighbours1, x)))
  distnei <- max(all.linked,50)
  dnearneigh(x,0,distnei)
}
within100nei <- function(x) {
  kneighbours1<- knn2nb(knearneigh(x,1))
  all.linked <- max(unlist(nbdists(kneighbours1, x)))
  distnei <- max(all.linked,100)
  dnearneigh(x,0,distnei)
}
#function based on all members being linked
withinAllnei <- function(x) {
  distnei <- max(dist(x),diag=T,upper=T)
  dnearneigh(x,0,distnei)
}
#function based on all members farther than 50 mts being linked
within50Allnei <- function(x) {
  kneighbours1<- knn2nb(knearneigh(x,1))
  all.linked <- max(unlist(nbdists(kneighbours1, x)))
  diststreetnei <- round(dist(matrix(c(max(rnorm(10000,0,0.1)),max(rnorm(10000,0,0.1)),min(rnorm(10000,0,0.1)),min(rnorm(10000,0,0.1))),ncol=2,byrow=TRUE)),1) #defining max distance to be considered as a neighbour, so that, after jittering we still identify those living in the same street as neighbours
  distnei <- max(all.linked,diststreetnei)
  distnei50 <- max(all.linked,50)
  distneiall <- max(dist(x),diag=T,upper=T)
  if(distnei50 >= distneiall) {
    if(distnei>=distneiall){
      dd <- dnearneigh(x,0,distnei) 
    } else {
      dd <- dnearneigh(x,distnei,distneiall)   
    }
  } else {
    dd <- dnearneigh(x,distnei50,distneiall) 
  }
  if(min(unlist(lapply(dd,length)))>1 ){
    return(dd)    
  } else{
    dnearneigh(x,distnei,distneiall)
  }
}
# function to Geographically weighting characteristics and renaming the variables
weighting1 <- function(x,y) {
  colnamess <-colnames(x) 
  z <- lag.listw(y,x)
  colnames(z) <- paste(colnamess,"w",sep="")
  return(z)
}
#Function to geographically weight
#defining function for spatially weighting the endogenous part
weightinga <- function(x,y) {
  attr(x,"class") <- "data.frame"
  x[,paste(wvar,".",aa,sep="")] <- lag.listw(y,x[,paste(wvar,".",aa,sep="")])
}
# function to create leave--one out averages
witaver<-function(x) (sum(x)-x)/(length(x)-1)

# function to compute Hausman McFadden IIA test, which generalises the inverse of hessian if it is singular
hmftestjg <- function (x, z, ...) {
  if (is.character(z)) 
    xs <- update(x, alt.subset = z)
  if (class(z) == "mnlogit") 
    xs <- z
  coef.x <- coef(x)
  coef.s <- coef(xs)
  un <- names(coef.x) %in% names(coef.s)
  diff.coef <- coef.s - coef.x[un]
  diff.var <- vcov(xs) - vcov(x)[un, un]
  if (class(try(solve(diff.var))) == "try-error") {
    hmf <- as.numeric(diff.coef %*% Ginv(diff.var) %*% diff.coef) ##calculates the generalised Moore-Penrose inverse. package("matlib") notice that this is suggested by Gill and King (2004)
  } else {
    hmf <- as.numeric(diff.coef %*% solve(diff.var) %*% diff.coef) ##solve(x) is the inverse of x
  }
  names(hmf) <- "chisq"
  df <- sum(un)
  names(df) <- "df"
  pv <- pchisq(hmf, df = df, lower.tail = FALSE)
  res <- list(data.name = x$call$data, statistic = hmf, p.value = pv, 
              parameter = df, method = "Hausman-McFadden test", alternative = "IIA is rejected")
  class(res) <- "htest"
  res
}

#  Then try/install packages...
foo(c("coda", "classInt", "data.table","doBy","estout","geoR","grDevices","ggplot2","fExtremes","foreign","gumbel","mlogit","mnlogit","maptools", "mapplots", 
      "MASS","plyr","RANN","RColorBrewer","nnet","reshape2","rgdal","rgeos","RColorBrewer", "sp", "spdep", "matlib"))

#"doBy" for summaryBy; #"foreign" for read.dta; #"estout"; "maptools" #readShapeSpatial and  readShapePoly(); "rgdal" #for writeOGR adn readOGR; 

# #To install mnlogit from CRAN archives
#url <- "https://cran.r-project.org/src/contrib/lmtest_0.9-37.tar.gz"
#pkgFile <- "lmtest_0.9-37.tar.gz"
#download.file(url = url, destfile = pkgFile)
# # Install package
#install.packages(pkgs=pkgFile, type="source", repos=NULL)
# # Delete package tarball
#unlink(pkgFile)


# #install.packages("pkgbuild")
# url <- "https://cran.r-project.org/src/contrib/Archive/mnlogit/mnlogit_1.2.5.tar.gz"
# pkgFile <- "mnlogit_1.2.5.tar.gz"
# download.file(url = url, destfile = pkgFile)
# # Install package
# install.packages(pkgs=pkgFile, type="source", repos=NULL)
# # Delete package tarball
# unlink(pkgFile)
# 
# install.packages("devtools")
# library(devtools)
# install_github("cran/lmtest")
# install_github("cran/mlogit")
# install_github("cran/mnlogit")
